home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / ddsgen.arc / DDSCSRC.CLP < prev    next >
Encoding:
Text File  |  1991-12-04  |  6.8 KB  |  87 lines
  1. /*------------------------------------------------------------------*/          
  2. /*  PROGRAM NAME: DDS01CSRC                                         */          
  3. /*  PURPOSE     : VALIDATE SOURCE FILE PARAMETER FOR DDS GENERATOR. */          
  4. /*  TYPE        : CL PROGRAM                                        */          
  5. /*                                                                  */          
  6. /*  AUTHOR      : TERRENCE W. MOYER                                 */          
  7. /*                55 KEPPEL AVE                                     */          
  8. /*                WEST LAWN, PA. 19609                              */          
  9. /*                                                                  */          
  10. /*  DATE        : NOVEMBER 1, 1986                                  */          
  11. /*                                                                  */          
  12. /*  *LDA USAGE  : THE FOLLOWING POSITIONS OF THE *LDA ARE RESERVED  */          
  13. /*                BY THE DDS GENERATOR SYSTEM FOR THE FOLLOWING     */          
  14. /*                PURPOSE.                                          */          
  15. /*    1 - 100  ....................INPUT  FILE DATA                 */          
  16. /*  101 - 200  ....................SOURCE FILE DATA                 */          
  17. /*  201 - 300  ....................MISCELLANEOUS SYSTEM DATA        */          
  18. /*                                                                  */          
  19. /*    1 -  10  &INFIL              INPUT FILE NAME                  */          
  20. /*   11 -  20  &INLIB              INPUT FILE LIBRARY               */
  21. /*   21 -  26  %SST(&WHCRTD 2 6)   FILE CREATE DATE  (YYMMDD)       */          
  22. /*   27 -  32  &PHFCTM             FILE CREATE TIME  (HHMMSS)       */          
  23. /*   33 -  33  &WHFTYP             FILE TYPE - P,L,D (PHY/LGL/DEV)  */          
  24. /*   51 - 100  &PHTXT              FILE LEVEL TEXT                  */          
  25. /*  101 - 110  &SRCFIL             SOURCE FILE NAME                 */          
  26. /*  111 - 120  &SRCLIB             SOURCE FILE LIBRARY              */          
  27. /*  121 - 130  &SRCFIL             SOURCE FILE MEMBER               */          
  28. /*  201 - 206                      CURRENT SOURCE SEQUENCE NUMBER.  */          
  29. /*  207 - 212                      DDS SOURCE DATE   (YYMMDD).      */          
  30. /*------------------------------------------------------------------*/          
  31.  PGM         PARM(&SRCFIL &SRCLIB)                                              
  32.              DCLF FILE(QAFDPHY.QSYS)                                            
  33.              DCL VAR(&SRCFIL)     TYPE(*CHAR) LEN(10)                           
  34.              DCL VAR(&SRCLIB)     TYPE(*CHAR) LEN(10)                           
  35.              DCL VAR(&MSGID)      TYPE(*CHAR) LEN(7)                            
  36.              DCL VAR(&MSGDTA)     TYPE(*CHAR) LEN(80)                           
  37.                                                                                 
  38.              MONMSG     MSGID(CPF0000) EXEC(GOTO RCVMSGS)                       
  39.                                                                                 
  40.              RMVMSG     CLEAR(*ALL) /* CLEAR PGM MSGQ BEFORE BEGIN */
  41.              OVRDBF     FILE(QAFDPHY) TOFILE(DSPFDPHY.QTEMP)                    
  42.                                                                                 
  43.  /* CHECK INPUT FILE AND SOURCE FILE EXISTENCE */                               
  44.              CHKOBJ     OBJ(&SRCFIL.&SRCLIB) OBJTYPE(*FILE)                     
  45.                                                                                 
  46.  /* CHECK FILE TYPE FOR *SRC */                                                 
  47.              DSPFD      FILE(&SRCFIL.&SRCLIB) TYPE(*ATR) +                      
  48.                         OUTPUT(*NONE) FILEATR(*PHY) +                           
  49.                         OUTFILE(DSPFDPHY.QTEMP)                                 
  50.              MONMSG     MSGID(CPF3000) EXEC(DO)                                 
  51.              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) +                          
  52.                           MSGDTA('Invalid source file parameter. +              
  53.                           File: ' *cat &srcfil *cat ' is not +                  
  54.                           *SRC') TOPGMQ(*PRV) MSGTYPE(*ESCAPE)                  
  55.                         GOTO ENDPGM                                             
  56.              ENDDO                                                              
  57.              RCVF                                                               
  58.              DLTOVR     FILE(QAFDPHY)                                           
  59.              IF         COND(&PHDTAT *NE 'S') THEN(DO)                          
  60.              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Invalid +
  61.                           source file parameter. Data type is not +             
  62.                           *SRC') TOPGMQ(*PRV) MSGTYPE(*ESCAPE)                  
  63.              ENDDO                                                              
  64.                                                                                 
  65.              IF         COND(&SRCLIB = '*LIBL') THEN(CHGDTAARA +                
  66.                         DTAARA(*LDA (111 10)) VALUE(&PHLIB))                    
  67.                                                                                 
  68.  GOTO  ENDPGM                                                                   
  69.                                                                                 
  70. /*     ***RECEIVE ERROR MESSAGES AND SEND TO CALLING PROGRAM***               */
  71.  RCVMSGS:    RMVMSG     PGMQ(*PRV)  CLEAR(*ALL)                                 
  72.  RCV1:       RCVMSG     MSGDTA(&MSGDTA) MSGID(&MSGID)                           
  73.              IF         COND(&MSGID = ' ') THEN(DO)                             
  74.              SNDPGMMSG  MSGID(CPF9999) MSGF(QCPFMSG) TOPGMQ(*PRV) +             
  75.                         MSGTYPE(*ESCAPE)                                        
  76.                         GOTO  ENDPGM                                            
  77.                         ENDDO                                                   
  78.              ELSE       DO                                                      
  79.              SNDPGMMSG  MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +           
  80.                         TOPGMQ(*PRV) MSGTYPE(*COMP)
  81.                         GOTO   RCV1                                             
  82.              ENDDO                                                              
  83.                                                                                 
  84.  ENDPGM:     RETURN                                                             
  85.              ENDPGM
  86. 
  87.